home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 038a / aplibs91.zip / BOXES-U.BAS < prev    next >
BASIC Source File  |  1991-04-12  |  10KB  |  277 lines
  1.  
  2.  
  3.  
  4. '==============================================================================
  5. '                         ALL-PURPOSE LIBARY
  6. '
  7. '                    THE FOURTH UNIT -- BOXES-U.BAS
  8. '==============================================================================
  9. '                                                               -- 2-18-90
  10. '                                                                  H Ballinger
  11.                             $COMPILE UNIT
  12.                             $ERROR ALL ON
  13.  
  14.  
  15.  DEFINT A-Z
  16.  %Center = 0
  17.  
  18.  EXTERNAL RD$, ColorDisplay, NeedDCon, FlashBox
  19.  EXTERNAL BoxColor, FldColor, WinColor, CursorTop, CursorBottom, Ln, Col
  20.  EXTERNAL PressAKeyBeep$, OopsBeep$, TinyBeep$
  21.  EXTERNAL LocalAreaCode$, Record%
  22.  EXTERNAL BXScreenSaved, PMScreenSaved
  23.  EXTERNAL FieldName$(), FieldMask$(), FL(), FC(), Fields%
  24.  
  25.  
  26. SUB BOXMESSAGE(CornerLin, CornerCol, Margin) PUBLIC
  27. '   ====                   Boxes and displays your message.
  28. '                          Top L. corner will be at the designated coordinates,
  29. '                          but errors are trapped so box will stay on the
  30. '                          screen regardless. The message line should appear
  31. '                          in your code as DATA statements, terminated by
  32. '                          "END". A RESTORE statement is needed, of course.
  33. '                          See HBDEMO.BAS for examples & comments.
  34.  
  35.  LOCAL I$(), MaxL, Items%, D$
  36.  
  37.   LOCATE ,,0 '                                           extinguish the cursor
  38. BReadlines:
  39.  DIM I$(23)                      ' each I$ is a msg line; # of lines is Items%
  40.  READ D$
  41.  WHILE D$ <> "END" AND Items% < 23 '                          (from data list)
  42.    INCR Items% '                                                 count 1 item
  43.    I$(Items%) = D$ '                                   plug the data into array
  44.    IF LEN(D$) > MaxL THEN MaxL = LEN(D$)  '         MaxL = length of longest I$()
  45.    READ D$ '                                                    ... and repeat.
  46.    WEND
  47.  
  48.           CALL BOXMESSAGE2 (CornerLin, CornerCol, Margin, I$(), Items%, MaxL)
  49.  END SUB                                                         REM BOXMESSAGE
  50. '______________________________________________________________________________
  51.  
  52. SUB BOXMESSAGE2 (CornerLin, CornerCol, Margin, I$(1), Items%, MaxL) PUBLIC
  53.  
  54. '    Use this call if you wish to set text lines -- I$() -- at runtime instead
  55. '    of using DATA statements ...
  56.  
  57.  LOCAL Wid, Height, I, P, Y, Z, F, Bar$
  58.  
  59. BSetVars:
  60.  Items% = MIN (Items%, 23) '                  can't contain > 23 limes of text.
  61.  Margin = MIN ((23 - Items%) / 2, Margin) '    if margin too big, reduce.
  62.  
  63.  Wid = MaxL + 4 + 4*Margin '        Total width of box: length of longest text
  64.  '                                  string + 2 for sides, 4 for spaces, and 4
  65.  '                                  for each unit of margin (2 each side).
  66.  
  67.  Items% = MIN (Items%, 23)
  68.  Margin = MIN ((23 - Items%) / 2, Margin)
  69.  
  70.  Height = Items% + 2 + 2*Margin '     Height: add 2 for each unit of margin
  71.  Wid = MIN (Wid, 80)
  72.  Height = MIN (Height, 25)
  73.  
  74.  IF CornerCol = %Center THEN CornerCol = 41 - Wid / 2  '  horiz centering ...
  75.  
  76.  CornerCol = MIN (CornerCol, 81 - Wid) '       If CornerCol + Wid > 80, fix it.
  77.  
  78.  CornerCol = MAX (CornerCol, 1) '                            CornerCol not < 1.
  79.  
  80.  
  81.  IF CornerLin = %Center THEN CornerLin = 13 - Height / 2
  82.  
  83.  CornerLin = MIN (CornerLin, 26-Height)
  84.  
  85.  CornerLin = MAX (1, CornerLin)
  86. '                                             error traps keep box on screen
  87.  
  88.  Bar$ = "\"+SPACE$(Wid-4)+"\" '                                 set a line mask
  89.  
  90. BPrint:
  91.  LOCATE CornerLin, CornerCol
  92.  I = BoxColor MOD 16
  93.  P = BoxColor \ 16 '                 set local variables for colors and
  94.  F = FlashBox * -16 '                  if box to flash, let F = 16
  95. '### LOCATE 25,1: PRINT "I = "; I, "F ="; F, "P = "; P, "I + F = ";I + F;: DELAY 5
  96.  COLOR  I + F ,  P
  97.  '                                                                print top bar
  98.  PRINT CHR$(201);: PRINT STRING$ ((Wid-2), 205);: PRINT CHR$ (187);
  99.  Z = CornerLin+1
  100.  
  101. IF Margin > 0 THEN
  102.   FOR Y = 1 TO Margin
  103.     LOCATE Z ,CornerCol
  104.     COLOR  I + F ,  P : PRINT CHR$(186);: COLOR  I , P
  105.     PRINT USING Bar$;" ";
  106.     COLOR  I + F ,  P : PRINT CHR$(186);: COLOR  I , P
  107.     INCR Z
  108.   NEXT
  109. END IF
  110.  '
  111.                                       ' print message lines
  112.  FOR Y = 1 TO Items%
  113.    LOCATE Z,CornerCol
  114.    COLOR  I + F ,  P : PRINT CHR$(186);: COLOR  I , P '  print border char.
  115.    PRINT USING BAR$; SPACE$(2*Margin + (MaxL-Len(I$(Y))) / 2 + .9) + I$(Y);
  116. '          count off enough spaces to center the characters then print 'em ...
  117.    COLOR  I + F ,  P : PRINT CHR$(186); '    and print right hand border.
  118.    INCR Z
  119.  NEXT
  120.  
  121.  IF Margin THEN '                print appropriate # of blank lines for margin
  122.    FOR Y = 1 TO Margin
  123.     LOCATE Z,CornerCol
  124.     COLOR  I + F ,  P : PRINT CHR$(186);: COLOR  I , P
  125.     PRINT USING Bar$;" ";
  126.     INCR Z
  127.     COLOR  I + F ,  P : PRINT CHR$(186);
  128.    NEXT
  129.  END IF
  130.  '                                                             print bottom bar
  131.  LOCATE Z, CornerCol, 1: PRINT CHR$ (200);: PRINT STRING$ ((Wid-2), 205);
  132.    PRINT CHR$(188);
  133.  COLOR  I ,  P
  134.  FlashBox = 0
  135.  
  136.  
  137.  END SUB                                                        REM BOXMESSAGE2
  138.  
  139. ' =============================================================================
  140.  
  141.  
  142. SUB POPWINDOW  PUBLIC                         ' print a data entry window ...
  143. '                                                and set up its lookup table
  144.  
  145.  LOCAL X, Y, Z, Title$, CornerCol, CornerLin, Prompt$, Ht, A$
  146.  COLOR WinColor MOD 16, WinColor \ 16
  147.  READ A$: Wid = VAL(A$)
  148.  READ A$: CornerLin = VAL(A$)
  149.  READ A$: CornerCol = VAL(A$)
  150.  READ A$: Ht = VAL(A$)
  151. '                                                       print top of window ...
  152.  LOCATE CornerLin, CornerCol: PRINT CHR$(201);
  153.                 PRINT STRING$((Wid-2),205);: PRINT CHR$(187);
  154.  
  155.  FOR Z = CornerLin+1 TO CornerLin+Ht-2 '                              sides ...
  156.     LOCATE Z, CornerCol: PRINT CHR$(186);SPACE$(Wid-2); CHR$(186);
  157.  NEXT Z
  158.  '                                                  ... print bottom bar.
  159.  LOCATE Z, CornerCol:PRINT CHR$(200);
  160.                 PRINT STRING$((Wid-2),205);: PRINT CHR$(188);
  161.  
  162.   READ Prompt$, X, Y '               place prompts in window (you hope ...)
  163.  DO
  164.   LOCATE X, Y: PRINT Prompt$
  165.   READ Prompt$: IF Prompt$ <> "END" THEN READ X, Y
  166.  LOOP UNTIL Prompt$ = "END"
  167.  
  168.  COLOR FldColor MOD 16, FldColor \ 16
  169.  
  170.  Z=1
  171.  
  172.  READ FieldName$(Z),FieldMask$(Z),FL(Z),FC(Z) '      create the table for
  173. '                                                      this record data window
  174.  DO
  175.    LOCATE FL(Z),FC(Z)
  176.    PRINT SPACE$ (LEN(FieldMask$(Z))) '                 print a blank field ...
  177.   INCR Z
  178.   READ FieldName$(Z)
  179.   IF FieldName$(Z) <> "END" THEN READ FieldMask$(Z), FL(Z), FC(Z)
  180.  LOOP UNTIL FieldName$(Z) = "END"
  181.  
  182.  
  183.  Fields% = Z-1
  184.  
  185.  END SUB
  186.  
  187. ' ----------------------------------------------------------------------------
  188.  
  189.  
  190. SUB PWSetUp (Fld$,Z) PUBLIC    ' sets up to ENTER a record field at the right
  191. '                         location in a pop-up data record window using the
  192. '                         lookup table (FieldName$() etc.). When a match is
  193. '                         found the cursor is placed. The subscript # used
  194. '                         is returned as the parameter Z.
  195.  
  196.  Z = 1
  197.  
  198.  DO UNTIL FieldName$(Z) = Fld$                         'find fld name in table
  199.   INCR Z
  200.   IF Z > Fields% THEN
  201.      BEEP
  202.      LOCATE 25,1
  203.      PRINT "            PWSetUp error: window for "+Fld$+" not open !!!          "
  204.      DO: LOOP UNTIL INKEY$ <> ""
  205.      END 1
  206.   END IF
  207.  LOOP
  208.  
  209.  LOCATE FL(Z), FC(Z)
  210.  COLOR FldColor MOD 16, FldColor \ 16
  211.  
  212.  END SUB                                                REM PWSetUp
  213.  
  214. ' =========================================================================
  215.  
  216. SUB QBOX (L%, C%, Lines%, Message$, AnsFldLength) PUBLIC
  217.  
  218.   LOCAL I$(), AFCol, AFLin, Items, MaxL
  219.   DIM I$(4)
  220.   AnsFldLength = MIN (AnsFldLength, 75) '           trim excessive ans length
  221.  
  222.   IF Lines% > 1 THEN
  223. '                                 THREE LINE Q-BOX
  224.     IF L = %Center THEN L = 11
  225.     L = MIN (L, 21)
  226.     Message$ = LEFT$ (Message$, 76) '  trim excessive prompt
  227.     I$(1) = Message$
  228.     Items% = 3
  229.     I$(2) = " "
  230.     I$(3) = " "
  231.     MaxL = MAX (LEN (Message$), AnsFldLength)
  232.     IF C = %Center THEN C = FIX ((76 - MaxL) / 2)
  233.     C = MIN (C, 76 - MaxL)
  234.     AFCol = C + 2
  235.     IF LEN(Message$) > AnsFldLength THEN
  236.       AFCol = C + 2 + (LEN(Message$)-AnsFldLength)/2
  237.     END IF
  238.     AFLin = L + 3
  239.  
  240.   ELSE
  241. '                             ONE LINE Q-BOX:
  242. '                                      if it's all too long, trim prompt ...
  243.     Message$ = LEFT$ (Message$, 75 - AnsFldLength)
  244.     IF C = %Center THEN C = (80 - LEN (Message$) - AnsFldLength) / 2
  245.     IF L = %Center THEN L = 12
  246.     IF AnsFldLength = 0 THEN
  247.       I$(1) = Message$
  248.     ELSE
  249.       I$(1) = Message$ + SPACE$ (AnsFldLength + 1)
  250.     END IF
  251.     Items% = 1
  252. '                                  if C + box width > 80, decrease it to fit
  253.     C = MIN (C, 76 - LEN(Message$) - AnsFldLength)
  254.     AFCol = C + 3 + LEN (Message$)
  255.     AFLin = MIN (L+1, 24)
  256.     MaxL = LEN(Message$) + AnsFldLength + 1
  257.  
  258.   END IF
  259.  
  260.       CALL BOXMESSAGE2 (L,C,0,I$(),Items%,MaxL)
  261.  
  262.   LOCATE AFLin,AFCol,1
  263.   END SUB
  264.  
  265.     '  exit with cursor set correctly at the end of the prompt$ so you
  266.     '   can immediately call a keyboard input routine like those in FENTRY-U.
  267.  
  268. ' --------------------------------------------------------------------------
  269. SUB Marker2 (Z$) '                                I tried to use SUB Marker
  270.   LOCAL L, C '                                    in this unit. Oops! it
  271.   L = CSRLIN: C = POS '                           calls QBox. Nice demonstration
  272.   LOCATE 1,1: PRINT ">>>>>>> "; Z$; " <<<<<<<<" ' of raging recursion !!!
  273.   DO: LOOP UNTIL INKEY$ <> ""
  274.   LOCATE L,C
  275. END SUB
  276.  
  277.